home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the Mac Game Programming Gurus / TricksOfTheMacGameProgrammingGurus.iso / More Source / Libraries / SAT 2.3b4 / Demo ƒ / HeartQuest demo ƒ / Preferences.p < prev    next >
Encoding:
Text File  |  1995-01-16  |  6.9 KB  |  238 lines  |  [TEXT/PJMM]
  1. {Preferences file handling}
  2.  
  3. {Principle: If we can write in the app itself, we do, but if not, or if there is already}
  4. {a prefs file, we use a pref file in the system folder. (The idea is that it is very elegant}
  5. {to save prefs in the application, whenever that is allowable.)}
  6.  
  7. {New version (march -94), stand-alone, takes file name and type as parameters,}
  8. {can be forced to create a pref file, includes resource copying routine.}
  9.  
  10. {Revised 12/10-94: Cleaned up some junk.}
  11.  
  12. {What can we improve? Removing the last globals?}
  13. {Kolla "shared"-flagga och sätta alwaysExternal efter den? (Bra idé!) Kan man kolla om}
  14. {file sharing är på?}
  15.  
  16. unit Preferences;
  17.  
  18. {Made with help from the sources of}
  19. {DeHQX v2.0.0 © Peter Lewis, Aug 1991 }
  20. {Thanks, Peter, for sharing your sources with us!}
  21.  
  22. interface
  23. {$ifc UNDEFINED THINK_PASCAL}
  24.     uses
  25.         Types, QuickDraw, Events, Windows, Dialogs, Fonts, DiskInit, TextEdit, Traps, Desk, Memory, SegLoad, Scrap, ToolUtils, OSEvents, OSUtils, Menus, Resources, StandardFile, GestaltEqu, Files, Errors;
  26. {$endc}
  27.  
  28.     var
  29.         gAppFile, gPrefFile: integer; {refnumbers to pass to UseResFile.}
  30.         sysenv: SysEnvRec;
  31.  
  32.     function SetPrefFile (prefsFileName: Str255; prefCreator, prefType: OSType; alwaysExternal: Boolean): Boolean;
  33. {Open the pref file if needed. Set the global variables gAppFile and gPrefFile.}
  34. {If alwaysExternal is true, we always want a pref file in the system folder even if we can save in the application.}
  35. {Returns true if a new gPrefFile was created.}
  36.  
  37. {Copy a resource from one file to another. Useful when SetPrefFile returns true!}
  38.     function CopyResource (fromFile, toFile: integer; theResType: ResType; id: integer): OSErr;
  39.  
  40. implementation
  41.  
  42. { 1) hitta Preferencefolder}
  43. { 2) Kolla om prefsfil existerar. I så fall, öppna den och gå till 6. }
  44. { 3) Hämta resurs och ändra den med ChangeResource. Om det gick, gå till 6.}
  45. { 4) Skapa prefsfil och öppna den.}
  46. { 5) Hämta resurser ur programmet och kopiera in i prefsfilen}
  47. { 6) Hämta resurser och skapa om de inte finns.}
  48.  
  49.     const
  50. { From Folders:}
  51.         kPreferencesFolderType = 'pref';        {preferences for applications go here}
  52.  
  53. { From Folders:}
  54.     function FindFolder (vRefNum: INTEGER; folderType: OSType; createFolder: BOOLEAN; var foundVRefNum: INTEGER; var foundDirID: LONGINT): OSErr;
  55.     inline
  56.         $7000, $A823;
  57.  
  58.     function GetDirID (wdrn: integer; var vrn: integer; var dirID: longInt): OSErr;
  59.         var
  60.             procID: longInt;
  61.             oe: OSErr;
  62.     begin
  63.         oe := GetWDInfo(wdrn, vrn, dirID, procID);
  64.         if oe <> noErr then
  65.             begin
  66.                 vrn := wdrn;
  67.                 dirID := 0;
  68.             end;
  69.         GetDirID := oe;
  70.     end;
  71.  
  72.     function GetPrefsFolder (var ovrn: integer): OSErr;
  73.         var
  74.             vrn: integer;
  75.             sDirID: longint;
  76.             oe: OSErr;
  77.             pb: WDPBRec;
  78.             oDirID: longint; {förr var-deklarerad utvariabel}
  79.             oVolID: integer;{förr var-deklarerad utvariabel}
  80.     begin
  81.         if SysEnvirons(1, sysenv) <> noErr then
  82.             ;
  83.         vrn := sysenv.sysVRefNum;
  84.         if sysenv.systemVersion >= $0700 then {System7}
  85.             begin
  86.                 sDirID := 0;
  87.                 oe := GetDirID(vrn, vrn, sDirID);
  88.                 oe := FindFolder(vrn, kPreferencesFolderType, true, oVolID, oDirID);
  89.  
  90. {Convert FindFolders volref+dirid to WDref}
  91.                 pb.ioVRefNum := oVolID;
  92.                 pb.ioWDProcID := longint('ERIK');
  93.                 pb.ioWDDirID := oDirID;
  94.                 pb.ioWDIndex := 0;
  95. {pb.ioWDVRefNum := -1; {???}
  96.                 pb.ioNamePtr := nil;
  97.                 pb.ioCompletion := nil;
  98.                 oe := PBOpenWD(@pb, false);
  99.                 ovrn := pb.ioVRefNum; {WDRefNum}
  100.             end
  101.         else
  102.             begin
  103.                 ovrn := vrn;
  104.                 oe := NoErr;
  105.             end;
  106.         GetPrefsFolder := oe;
  107.     end; {GetPrefsFolder}
  108.  
  109. {function SetPrefFile: boolean;}
  110.     function SetPrefFile (prefsFileName: Str255; prefCreator, prefType: OSType; alwaysExternal: Boolean): Boolean;
  111.         var
  112.             err: OSErr;
  113.             prefsFolder: integer;
  114.             h: handle;
  115.             s: str255;
  116.     begin
  117.         gAppFile := CurResFile; {spara programmerts resursfilreferens}
  118.         gPrefFile := 0;
  119.         SetPrefFile := false;
  120. { 1) hitta Preferencefolder}
  121.         err := GetPrefsFolder(prefsFolder);{, PrefsFolderId, PrefsVolId}
  122.         if err <> NoErr then
  123.             ;
  124. {SATReportStr('Error finding system folder.')}
  125.  
  126. { 2) Kolla om prefsfil existerar. I så fall, öppna den och gå till 6. }
  127.         gPrefFile := OpenRFPerm(prefsFileName, prefsFolder, FSRdWrPerm);
  128.         if ResError = noErr then
  129.             begin
  130.             end
  131.         else
  132.             begin
  133.                 gPrefFile := 0;
  134.  
  135. { 3) Get some resource and change it with ChangeResource. If that works, go to 6.}
  136. {Om alwaysExternal är true behöver vi inte kolla - då vill vi ha en }
  137.                 if not alwaysExternal then
  138.                     begin
  139.                         h := Get1IndResource(prefCreator, 1); {The signatur always exists if it has a BNDL.}
  140.                         if h = nil then
  141.                             begin
  142. {Error! Resursen saknas!}
  143. {SATReportStr('Resource missing!');}
  144.                             end;
  145.                         ChangedResource(h);
  146.                         alwaysExternal := ResError <> noErr; {Lite fult att ändra "always", men nu vill vi ju ha extern!}
  147.                         ReleaseResource(h); {OK, done with the resource}
  148.                     end;
  149.  
  150.                 if alwaysExternal then
  151.                     begin
  152. { 4) Create prefs file and open it.}
  153.                         err := Create(PrefsFileName, prefsFolder, prefCreator, prefType);
  154.                         if err = noErr then
  155.                             begin
  156.                                 ;
  157. {SATReportStr('Application locked. Creating prefs file instead.')}
  158.  
  159.                                 HCreateResFile(prefsFolder, 0, prefsFileName);{???}
  160.                                 if ResError <> noErr then
  161.                                     begin
  162. {SATReportStr('Couldn''t create resource fork!');}
  163.                                     end
  164.                                 else
  165.                                     gPrefFile := OpenRFPerm(prefsFileName, prefsFolder, FSRdWrPerm);
  166.  
  167.                                 if ResError = noErr then
  168.                                     SetPrefFile := true; {new pref file!}
  169. { 5) Hämta resurser ur programmet och kopiera in i prefsfilen}
  170.                             end{Create succeeded}
  171.                         else
  172. {SATReportStr('Failed to create prefsfile!')}
  173.                             ;
  174.                     end; {Programmet skrivskyddat.}
  175.             end; {prefsfil existerade inte}
  176. { 6) Hämta resurser och skapa om de inte finns.}
  177.     end;
  178.  
  179.  
  180. {Kopiera resurs:}
  181.     function CopyResource (fromFile, toFile: integer; theResType: ResType; id: integer): OSErr;
  182.         var
  183.             oldResFile: integer;
  184.             res, rescopy: Handle;
  185.             wasLoaded: Boolean;
  186.             theID: integer;
  187.             theType: ResType;
  188.             theName: Str255;
  189.         procedure Barf;
  190.         begin
  191.             CopyResource := ResError;
  192.             UseResFile(oldResFile); {återställ}
  193.             exit(CopyResource);
  194.         end;
  195.         procedure CheckError;
  196.         begin
  197.             if ResError <> noErr then
  198.                 Barf;
  199.         end; {CheckError}
  200.     begin
  201.         oldResFile := CurResFile;
  202.         UseResFile(fromFile);
  203.         CheckError;
  204.  
  205.         SetResLoad(false);
  206.         res := Get1Resource(theResType, id);
  207. {Don't CheckError before doing SetResLoad(true)!!!}
  208.         SetResLoad(true);
  209.         CheckError;
  210.         if res <> nil then
  211.             begin
  212.                 wasLoaded := res^ = nil;
  213.                 LoadResource(res);
  214.                 CheckError;
  215.                 UseResFile(toFile);
  216.                 CheckError;
  217.                 GetResInfo(res, theID, theType, theName);
  218.                 CheckError;
  219.                 rescopy := res;
  220.                 if HandToHand(rescopy) <> noErr then
  221.                     Barf; {i stället för DetachResource(res);}
  222.                 CheckError;
  223.                 AddResource(rescopy, theResType, id, theName);
  224.                 CheckError;
  225.                 ReleaseResource(rescopy);
  226.                 if not wasLoaded then
  227.                     ReleaseResource(res); {If it wasn't loaded before, it shouldn't be afterwards.}
  228.                 CheckError;
  229.                 CopyResource := noErr;
  230.             end
  231.         else
  232.             begin
  233.                 CopyResource := resNotFound;
  234.             end;
  235.         UseResFile(oldResFile);
  236.     end;
  237.  
  238. end.